home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-strmap.adb < prev    next >
Text File  |  1996-01-30  |  8KB  |  282 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                     A D A . S T R I N G S . M A P S                      --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.12 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Note: parts of this code are derived from the ADAR.CSH public domain
  27. --  Ada 83 versions of the Appendix C string handling packages. The main
  28. --  differences are that we avoid the use of the minimize function which
  29. --  is bit-by-bit or character-by-character and therefore rather slow.
  30. --  Generally for character sets we favor the full 32-byte representation.
  31.  
  32. package body Ada.Strings.Maps is
  33.  
  34.    ------------
  35.    -- To_Set --
  36.    ------------
  37.  
  38.    function To_Set (Ranges : in Character_Ranges) return Character_Set is
  39.       Result : Character_Set;
  40.  
  41.    begin
  42.       for C in Result'Range loop
  43.          Result (C) := False;
  44.       end loop;
  45.  
  46.       for R in Ranges'Range loop
  47.          for C in Ranges (R).Low .. Ranges (R).High loop
  48.             Result (C) := True;
  49.          end loop;
  50.       end loop;
  51.  
  52.       return Result;
  53.    end To_Set;
  54.  
  55.    function To_Set (Span   : in Character_Range) return Character_Set is
  56.       Result : Character_Set;
  57.  
  58.    begin
  59.       for C in Result'Range loop
  60.          Result (C) := False;
  61.       end loop;
  62.  
  63.       for C in Span.Low .. Span.High loop
  64.          Result (C) := True;
  65.       end loop;
  66.  
  67.       return Result;
  68.    end To_Set;
  69.  
  70.    ---------------
  71.    -- To_Ranges --
  72.    ---------------
  73.  
  74.    function To_Ranges (Set : in Character_Set) return Character_Ranges is
  75.       Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1);
  76.       Range_Num  : Natural;
  77.       C          : Character;
  78.  
  79.    begin
  80.       C := Character'First;
  81.       Range_Num := 0;
  82.  
  83.       loop
  84.          --  Skip gap between subsets.
  85.  
  86.          while not Set (C) loop
  87.             exit when C = Character'Last;
  88.             C := Character'Succ (C);
  89.          end loop;
  90.  
  91.          exit when not Set (C);
  92.  
  93.          Range_Num := Range_Num + 1;
  94.          Max_Ranges (Range_Num). Low := C;
  95.  
  96.          --  Span a subset.
  97.  
  98.          loop
  99.             exit when not Set (C) or else C = Character'Last;
  100.             C := Character' Succ (C);
  101.          end loop;
  102.  
  103.          if Set (C) then
  104.             Max_Ranges (Range_Num). High := C;
  105.             exit;
  106.          else
  107.             Max_Ranges (Range_Num). High := Character'Pred (C);
  108.          end if;
  109.       end loop;
  110.  
  111.       return Max_Ranges (1 .. Range_Num);
  112.    end To_Ranges;
  113.  
  114.    ---------
  115.    -- "-" --
  116.    ---------
  117.  
  118.    function "-" (Left, Right : Character_Set) return Character_Set is
  119.    begin
  120.       return Left and not Right;
  121.    end "-";
  122.  
  123.    -----------
  124.    -- Is_In --
  125.    -----------
  126.  
  127.    function Is_In
  128.      (Element : Character;
  129.       Set     : Character_Set)
  130.       return    Boolean
  131.    is
  132.    begin
  133.       return Set (Element);
  134.    end Is_In;
  135.  
  136.    ---------------
  137.    -- Is_Subset --
  138.    ---------------
  139.  
  140.    function Is_Subset
  141.      (Elements : Character_Set;
  142.       Set      : Character_Set)
  143.       return     Boolean
  144.    is
  145.    begin
  146.       return (Elements and Set) = Elements;
  147.    end Is_Subset;
  148.  
  149.    ----------------
  150.    -- To_Mapping --
  151.    ----------------
  152.  
  153.    function To_Mapping
  154.      (From, To : in Character_Sequence)
  155.       return     Character_Mapping
  156.    is
  157.       Result   : Character_Mapping;
  158.       Inserted : Character_Set := Null_Set;
  159.       From_Len : constant Natural := From'Length;
  160.       To_Len   : constant Natural := To'Length;
  161.  
  162.    begin
  163.       if From_Len /= To_Len then
  164.          raise Strings.Translation_Error;
  165.       end if;
  166.  
  167.       for Char in Character loop
  168.          Result (Char) := Char;
  169.       end loop;
  170.  
  171.       for J in From'Range loop
  172.          if Inserted (From (J)) then
  173.             raise Strings.Translation_Error;
  174.          end if;
  175.  
  176.          Result   (From (J)) := To (J - From'First + To'First);
  177.          Inserted (From (J)) := True;
  178.       end loop;
  179.  
  180.       return Result;
  181.    end To_Mapping;
  182.  
  183.    -----------------
  184.    -- To_Sequence --
  185.    -----------------
  186.  
  187.    function To_Sequence
  188.      (Set  : Character_Set)
  189.       return Character_Sequence
  190.    is
  191.       Result : String (1 .. Character'Pos (Character'Last));
  192.       Count  : Natural := 0;
  193.  
  194.    begin
  195.       for Char in Set'Range loop
  196.          if Set (Char) then
  197.             Count := Count + 1;
  198.             Result (Count) := Char;
  199.          end if;
  200.       end loop;
  201.  
  202.       return Result (1 .. Count);
  203.    end To_Sequence;
  204.  
  205.    ------------
  206.    -- To_Set --
  207.    ------------
  208.  
  209.    function To_Set (Sequence : Character_Sequence) return Character_Set is
  210.       Result : Character_Set := Null_Set;
  211.  
  212.    begin
  213.       for J in Sequence'Range loop
  214.          Result (Sequence (J)) := True;
  215.       end loop;
  216.  
  217.       return Result;
  218.    end To_Set;
  219.  
  220.    function To_Set (Singleton : Character) return Character_Set is
  221.       Result : Character_Set := Null_Set;
  222.  
  223.    begin
  224.       Result (Singleton) := True;
  225.       return Result;
  226.    end To_Set;
  227.  
  228.    -----------
  229.    -- Value --
  230.    -----------
  231.  
  232.    function Value (Map : in Character_Mapping; Element : in Character)
  233.       return Character is
  234.  
  235.    begin
  236.       return Map (Element);
  237.    end Value;
  238.  
  239.    ---------------
  240.    -- To_Domain --
  241.    ---------------
  242.  
  243.    function To_Domain (Map : in Character_Mapping) return Character_Sequence
  244.    is
  245.       Result : String (1 .. Map'Length);
  246.       J      : Natural;
  247.  
  248.    begin
  249.       J := 0;
  250.       for C in Map'Range loop
  251.          if Map (C) /= C then
  252.             Result (J) := C;
  253.             J := J + 1;
  254.          end if;
  255.       end loop;
  256.  
  257.       return Result (1 .. J);
  258.    end To_Domain;
  259.  
  260.    --------------
  261.    -- To_Range --
  262.    --------------
  263.  
  264.    function To_Range (Map : in Character_Mapping) return Character_Sequence
  265.    is
  266.       Result : String (1 .. Map'Length);
  267.       J      : Natural;
  268.  
  269.    begin
  270.       J := 0;
  271.       for C in Map'Range loop
  272.          if Map (C) /= C then
  273.             Result (J) := Map (C);
  274.             J := J + 1;
  275.          end if;
  276.       end loop;
  277.  
  278.       return Result (1 .. J);
  279.    end To_Range;
  280.  
  281. end Ada.Strings.Maps;
  282.